home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0187.ZIP / BOGGLE.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-20  |  3KB  |  140 lines
  1. program boggle(input,output);
  2. const
  3.    numdigits    = 4;           (* the number of digits in the number *)
  4. var
  5.    ch     : char;              (* used to answer questions *)
  6.    number : array[1..numdigits] of char; (* the actual number *)
  7.    numblack,                   (* number of correct digits *)
  8.    numwhite: 0..numdigits;     (* number of correct and ordered digits *)
  9.    numguess: integer;          (* number of guesses taken *)
  10.  
  11.  
  12. (*
  13.  * create
  14.  * create a random number
  15.  *)
  16. procedure create;
  17. var
  18.    i : 1..numdigits;           (* index variable *)
  19. begin
  20.    for i := 1 to numdigits do
  21.       number[i] := chr(ord('0') + random(10))
  22. end; (* create *)
  23.  
  24.  
  25. (*
  26.  * play
  27.  * gets a number from the player
  28.  * then figures out how many white,
  29.  * and black numbers he (she) has.
  30.  *)
  31.  
  32. procedure play;
  33. const
  34.    indexlength  = 5;   (* length of the indices *)
  35.  
  36. var
  37.    user   : string[4];           (* input from player *)
  38.    notbad : boolean;          (* used to test for garbage *)
  39.    i,j    : 1..indexlength;   (* index variables *)
  40.    used   : set of 1..numdigits; (* whether the digit has been used *)
  41.  
  42. begin
  43.    numwhite := 0;
  44.    numblack := 0;
  45.    write('Your guess? ');
  46.    readln(user);
  47.  
  48.    notbad := length(user) = numdigits;
  49.  
  50.    i := 1;
  51.  
  52.    while notbad and (i<= numdigits) do
  53.    begin
  54.       notbad := user[i] in ['0'..'9'];
  55.       i := i + 1
  56.    end;
  57.  
  58.    if not notbad then
  59.    begin
  60.       writeln('Illegal input, try again');
  61.       play
  62.    end
  63.    else
  64.    begin
  65.       used := [];
  66.       for i := 1 to numdigits do
  67.          if number[i] = user[i] then
  68.             numwhite := numwhite + 1;
  69.  
  70.       for i := 1 to numdigits do
  71.       begin
  72.          j := 1;
  73.          while j <= numdigits do
  74.          begin
  75.             if (user[i] = number [j]) and (i<>j) and not (j in used) then
  76.             begin
  77.                numblack := numblack + 1;
  78.                used := used + [j];
  79.                j := numdigits
  80.             end;
  81.             j := j + 1
  82.          end
  83.       end
  84.    end
  85. end;  (* play *)
  86.  
  87.  
  88. (*
  89.  * inst
  90.  * print out the instructions
  91.  *)
  92.  
  93. procedure inst;
  94.  
  95. begin
  96.    writeln('Boggle');
  97.    writeln;
  98.    writeln('A version of mastermind.');
  99.    writeln('I guess a number, then you attempt to');
  100.    writeln('find out what the number is. When');
  101.    writeln('you make a guess, I will tell you how');
  102.    writeln('many digits were correct and in their');
  103.    writeln('correct location (White numbers). I');
  104.    writeln('will also tell you how many digits were');
  105.    writeln('correct, but in the wrong place.');
  106.    writeln;
  107.    writeln('For example, is the number is 1234, and');
  108.    writeln('you guess 1467, then you would have');
  109.    writeln('1 white (the 1) and 1 black number (the 4),');
  110.    writeln
  111. end;  (* inst *)
  112.  
  113.  
  114. begin
  115.    write('Do you want instructions? ');
  116.    readln(ch);
  117.    if (ch='y') or (ch='Y') then
  118.       inst;
  119.  
  120.    repeat
  121.       randomize;
  122.       create;
  123.       numwhite := 0;
  124.       numblack := 0;
  125.       numguess := 0;
  126.       while numwhite <> numdigits do
  127.       begin
  128.          play;
  129.          writeln('White = ',numwhite,'  Black = ',numblack);
  130.          numguess := numguess + 1
  131.       end;
  132.       writeln;
  133.       writeln('Correct');
  134.       writeln('It took you ',numguess,' guesses.');
  135.       writeln;
  136.       write('Care to try again? ');
  137.       readln(ch);
  138.    until (ch<>'Y') and (ch<>'y')
  139. end.  (* boggle  *)
  140.